home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibcat.zip / PIBCATD.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-01  |  17KB  |  389 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Display_DWC_Contents --- Display contents of DWC file        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_DWC_Contents( DWCFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_DWC_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a DWC file                        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_DWC_Contents( DWCFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          DWCFileName --- name of DWC file whose contents are to be   *)
  18. (*                          listed.                                     *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Get_Unix_Date     --- convert Unix date to string           *)
  25. (*          Open_File         --- open a file                           *)
  26. (*          Close_File        --- close a file                          *)
  27. (*          Entry_Matches     --- Perform wildcard match                *)
  28. (*          Display_Page_Titles                                         *)
  29. (*                            --- Display titles at top of page         *)
  30. (*          DUPL              --- Duplicate a character into a string   *)
  31. (*                                                                      *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. (*----------------------------------------------------------------------*)
  35. (*                  Map of DWC file entry header                        *)
  36. (*----------------------------------------------------------------------*)
  37.  
  38. CONST
  39.    Max_Entries = 1800              (* Maximum # of files in DWC file *);
  40.  
  41. TYPE
  42.    FNameType = ARRAY[1..13] OF CHAR;
  43.    ID_Type   = ARRAY[1..3 ] OF CHAR;
  44.  
  45.                                    (* Header for entire DWC file *)
  46.    DWC_Header_Type = RECORD
  47.                         Size    : WORD       (* Size of archive structure, future expansion *);
  48.                         Ent_SZ  : BYTE       (* Size of directory entry, future expansion   *);
  49.                         Header  : FNameType  (* Name of Header file to print on listings    *);
  50.                         Time    : LONGINT    (* Time stamp of last modification to archive  *);
  51.                         Entries : LONGINT    (* Number of entries in archive                *);
  52.                         ID_3    : ID_Type    (* The string "DWC" to identify archive        *);
  53.                      END;
  54.                                    (* Individual file entry *)
  55.    DWC_Entry_Type  = RECORD
  56.                         Filename : FNameType (* File and extension       *);
  57.                         Size     : LONGINT   (* Original size            *);
  58.                         Time     : LONGINT   (* Packed date and time     *);
  59.                         New_Size : LONGINT   (* Compressed size          *);
  60.                         FPos     : LONGINT   (* Position in DWC file     *);
  61.                         Method   : BYTE      (* Compression method       *);
  62.                         SZ_C     : BYTE      (* Size of comment          *);
  63.                         SZ_D     : BYTE      (* Size of dir name on add  *);
  64.                         CRC      : WORD      (* Cyclic Redundancy Check  *);
  65.                      END;
  66.                                    (* Entire DWC directory *)
  67.  
  68.    DWC_Dir_Type    = ARRAY[1..Max_Entries] OF DWC_Entry_Type;
  69.    DWC_Dir_Ptr     = ^DWC_Dir_Type;
  70.  
  71. (* STRUCTURED *) CONST
  72.    DWC_ID : ID_Type = 'DWC';
  73.  
  74. VAR
  75.    DWCFile       : FILE            (* DWC file to be read             *);
  76.    DWC_Entry     : DWC_Entry_Type  (* Entry for one file in DWC lib   *);
  77.    DWC_Header    : DWC_Header_Type (* Main header for DWC file        *);
  78.    DWC_Pos       : LONGINT         (* Current byte offset in DWC file *);
  79.    Bytes_Read    : INTEGER         (* # bytes read from DWC file file *);
  80.    Ierr          : INTEGER         (* Error flag                      *);
  81.    Entry_To_Get  : INTEGER         (* Current entry being worked on   *);
  82.    Dir_In_Memory : BOOLEAN         (* TRUE if entire dir fits in RAM  *);
  83.    Dir_Ptr       : DWC_Dir_Ptr     (* Points to RAM-resident DWC dir  *);
  84.    Dir_Size      : WORD            (* Size in bytes of directory      *);
  85.    Long_Name     : AnyStr          (* Long file name                  *);
  86.  
  87. (*----------------------------------------------------------------------*)
  88. (*        Get_DWC_Header --- Get initial header entry in DWC file       *)
  89. (*----------------------------------------------------------------------*)
  90.  
  91. FUNCTION Get_DWC_Header( VAR Error : INTEGER ) : BOOLEAN;
  92.  
  93. (*----------------------------------------------------------------------*)
  94. (*                                                                      *)
  95. (*    Function:  Get_DWC_Header                                         *)
  96. (*                                                                      *)
  97. (*    Purpose:   Gets initial DWC header                                *)
  98. (*                                                                      *)
  99. (*    Calling sequence:                                                 *)
  100. (*                                                                      *)
  101. (*       OK := Get_DWC_Header( VAR Error : INTEGER ) : BOOLEAN;         *)
  102. (*                                                                      *)
  103. (*          Error    --- Error flag                                     *)
  104. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  105. (*                                                                      *)
  106. (*----------------------------------------------------------------------*)
  107.  
  108. CONST
  109.    BufSize = 256;
  110.  
  111. VAR
  112.    I        : INTEGER;
  113.    J        : INTEGER;
  114.    Buf      : ARRAY[1..BufSize] OF CHAR;
  115.    L        : LONGINT;
  116.    ID_Found : BOOLEAN;
  117.    ID_Ptr   : ^ID_Type;
  118.  
  119. BEGIN (* Get_DWC_Header *)
  120.                                    (* Assume no error to start *)
  121.    Error := 0;
  122.                                    (* Assume no space to hold entire  *)
  123.                                    (* directory in memory.            *)
  124.    Dir_In_Memory := FALSE;
  125.    Dir_Ptr       := NIL;
  126.                                    (* Try to find ID = 'DWC' near end *)
  127.                                    (* of file.  We will look up to 10 *)
  128.                                    (* 256 byte blocks away from end   *)
  129.                                    (* for this info.                  *)
  130.  
  131.    L        := FileSize( DWCFile );
  132.    I        := 1;
  133.    ID_Found := FALSE;
  134.  
  135.    REPEAT
  136.                                    (* Position to next potential block *)
  137.  
  138.       DWC_Pos := L - ( I * BufSize - PRED( I ) * 5 );
  139.  
  140.       IF ( DWC_Pos < 0 ) THEN
  141.          DWC_Pos := 0;
  142.  
  143.       SEEK( DWCFile , DWC_Pos );
  144.                                    (* Read in a block of information *)
  145.       IF ( IOResult = 0 ) THEN
  146.          BEGIN
  147.  
  148.             BlockRead( DWCFile, Buf, BufSize, Bytes_Read );
  149.  
  150.             IF ( IOResult = 0 ) THEN
  151.                BEGIN
  152.                                    (* See if we can find "DWC" here  *)
  153.  
  154.                   J := Bytes_Read - 2;
  155.  
  156.                   WHILE ( ( J > 0 ) AND ( NOT ID_Found ) ) DO
  157.                      BEGIN
  158.  
  159.                         ID_Ptr := @Buf[ J ];
  160.  
  161.                         IF ( ID_Ptr^ = DWC_ID ) THEN
  162.                            ID_Found := TRUE
  163.                         ELSE
  164.                            DEC( J );
  165.  
  166.                      END;
  167.                                    (* In case we need to try next block *)
  168.                   INC( I );
  169.  
  170.                END
  171.             ELSE
  172.                Error := Format_Error;
  173.  
  174.          END
  175.       ELSE
  176.          Error := Format_Error;
  177.  
  178.    UNTIL ( ( I > 10 ) OR ID_Found OR ( Error <> 0 ) );
  179.  
  180.                                    (* If we didn't find DWC, quit.         *)
  181.    IF ( NOT ID_Found ) THEN
  182.       Error := Format_Error
  183.    ELSE
  184.       BEGIN                        (* We found DWC.                       *)
  185.                                    (* True end of DWC file (we hope).     *)
  186.  
  187.          DWC_Pos := DWC_Pos + J + 2;
  188.  
  189.          SEEK( DWCFile , DWC_Pos - SIZEOF( DWC_Header ) );
  190.  
  191.          BlockRead( DWCFile, DWC_Header, SIZEOF( DWC_Header ), Bytes_Read );
  192.  
  193.                                    (* Check # of entries for reasonableness *)
  194.  
  195.          IF ( ( DWC_Header.Entries < 0 ) OR ( DWC_Header.Entries > Max_Entries ) ) THEN
  196.             Error := Format_Error
  197.          ELSE
  198.             BEGIN
  199.                                    (* # entries looked OK.  Pick up offset *)
  200.                                    (* of first directory entry.            *)
  201.  
  202.                WITH DWC_Header DO
  203.                   BEGIN
  204.                      Dir_Size := Entries * Ent_SZ;
  205.                      DWC_Pos  := DWC_Pos - ( Dir_Size + Size );
  206.                   END;
  207.  
  208.                SEEK( DWCFile , DWC_Pos );
  209.  
  210.                IF ( IOResult <> 0 ) THEN
  211.                   Error := Format_Error;
  212.  
  213.                                    (* See if we can read entire directory *)
  214.                                    (* into memory.  If so, do that now.   *)
  215.  
  216.                IF ( MaxAvail > Dir_Size ) THEN
  217.                   BEGIN
  218.  
  219.                      GETMEM( Dir_Ptr , Dir_Size );
  220.  
  221.                      IF ( Dir_Ptr <> NIL ) THEN
  222.                         BEGIN
  223.  
  224.                            Dir_In_Memory := TRUE;
  225.  
  226.                            BlockRead( DWCFile, Dir_Ptr^, Dir_Size, Bytes_Read );
  227.  
  228.                            IF ( ( IOResult <> 0 ) OR
  229.                               ( Bytes_Read < Dir_Size ) ) THEN
  230.                               Error := Format_Error;
  231.  
  232.                         END;
  233.  
  234.                   END;
  235.  
  236.             END;
  237.  
  238.       END;
  239.                                     (* Report success/failure to calling *)
  240.                                     (* routine.                          *)
  241.  
  242.    Get_DWC_Header := ( Error = 0 );
  243.  
  244. END   (* Get_DWC_Header *);
  245.  
  246. (*----------------------------------------------------------------------*)
  247. (*     Get_Next_DWC_Entry --- Get next header entry in DWC file         *)
  248. (*----------------------------------------------------------------------*)
  249.  
  250. FUNCTION Get_Next_DWC_Entry( VAR DWC_Entry : DWC_Entry_Type;
  251.                                  Entry_No  : INTEGER;
  252.                              VAR Error     : INTEGER  ) : BOOLEAN;
  253.  
  254. (*----------------------------------------------------------------------*)
  255. (*                                                                      *)
  256. (*    Function:  Get_Next_DWC_Entry                                     *)
  257. (*                                                                      *)
  258. (*    Purpose:   Gets header information for next file in DWC file      *)
  259. (*                                                                      *)
  260. (*    Calling sequence:                                                 *)
  261. (*                                                                      *)
  262. (*       OK := Get_Next_DWC_Entry( VAR DWC_Entry : DWC_Entry_Type;      *)
  263. (*                                     Entry_No  : INTEGER;             *)
  264. (*                                 VAR Error     : INTEGER ) : BOOLEAN; *)
  265. (*                                                                      *)
  266. (*          DWC_Entry --- Header data for next file in DWC file         *)
  267. (*          Error     --- Error flag                                    *)
  268. (*          Entry_No  --- Entry number to get (if resident dir)         *)
  269. (*          OK        --- TRUE if header successfully found, else FALSE *)
  270. (*                                                                      *)
  271. (*----------------------------------------------------------------------*)
  272.  
  273. BEGIN (* Get_Next_DWC_Entry *)
  274.                                    (* Assume no error to start       *)
  275.    Error := 0;
  276.                                    (* Read in the file header entry. *)
  277.  
  278.    IF Dir_In_Memory THEN
  279.       DWC_Entry := Dir_Ptr^[ Entry_No ]
  280.    ELSE
  281.       BEGIN
  282.  
  283.          BlockRead( DWCFile, DWC_Entry, SIZEOF( DWC_Entry ), Bytes_Read );
  284.  
  285.                                    (* If wrong size read, or header marker *)
  286.                                    (* byte is incorrect, report DWC file   *)
  287.                                    (* format error.                        *)
  288.  
  289.          IF ( ( IOResult <> 0 ) OR ( Bytes_Read < SIZEOF( DWC_Entry ) ) ) THEN
  290.             Error := Format_Error;
  291.  
  292.       END;
  293.                                     (* Report success/failure to calling *)
  294.                                     (* routine.                          *)
  295.  
  296.    Get_Next_DWC_Entry := ( Error = 0 );
  297.  
  298. END   (* Get_Next_DWC_Entry *);
  299.  
  300. (*----------------------------------------------------------------------*)
  301. (*        Display_DWC_Entry --- Display DWC file file entry info        *)
  302. (*----------------------------------------------------------------------*)
  303.  
  304. PROCEDURE Display_DWC_Entry( DWC_Entry : DWC_Entry_Type );
  305.  
  306. VAR
  307.    FName     : AnyStr;
  308.    TimeDate  : LONGINT;
  309.    DTRec     : DateTime;
  310.  
  311. BEGIN (* Display_DWC_Entry *)
  312.  
  313.    WITH DWC_Entry DO
  314.       BEGIN
  315.                                    (* Pick up file name *)
  316.  
  317.          FName := COPY( FileName, 1, PRED( POS( #0 , FileName ) ) );
  318.  
  319.                                    (* See if this file matches the   *)
  320.                                    (* entry spec wildcard.  Exit if  *)
  321.                                    (* not.                           *)
  322.  
  323.          IF Use_Entry_Spec THEN
  324.             IF ( NOT Entry_Matches( FName ) ) THEN
  325.                EXIT;
  326.                                    (* Get date and time of creation *)
  327.  
  328.          Get_Unix_Style_Date( Time, DTRec.Year, DTRec.Month, DTRec.Day,
  329.                                     DTRec.Hour, DTRec.Min, DTRec.Sec );
  330.  
  331.          PackTime( DTRec , TimeDate );
  332.  
  333.          Long_Name      := '';
  334.                                    (* Display info about this entry *)
  335.  
  336.          Display_One_Entry( FName, Size, TimeDate, DWCFileName,
  337.                             Current_Subdirectory, Long_Name );
  338.  
  339.       END;
  340.  
  341. END (* Display_DWC_Entry *);
  342.  
  343. (*----------------------------------------------------------------------*)
  344.  
  345. BEGIN (* Display_DWC_Contents *)
  346.  
  347.                                    (* Open DWC file and initialize *)
  348.                                    (* contents display.            *)
  349.  
  350.    IF Start_Contents_Listing( ' DWC file: ',
  351.                               Current_Subdirectory + DWCFileName, DWCFile,
  352.                               DWC_Pos, Ierr ) THEN
  353.       BEGIN
  354.                                    (* Loop over entries in DWC file *)
  355.                                    (* if DWC file opened OK.        *)
  356.  
  357.          IF Get_DWC_Header( Ierr ) THEN
  358.             BEGIN
  359.                                    (* Entry to get *)
  360.                Entry_To_Get := 1;
  361.                                    (* Loop over entries      *)
  362.  
  363.                WHILE ( ( Entry_To_Get <= DWC_Header.Entries ) AND
  364.                        ( Get_Next_DWC_Entry( DWC_Entry , Entry_To_Get , Ierr ) ) ) DO
  365.                   BEGIN
  366.                      Display_DWC_Entry( DWC_Entry );
  367.                      INC( Entry_To_Get );
  368.                   END;
  369.  
  370.             END
  371.          ELSE
  372.             BEGIN
  373.                Display_Error( 'Failed to get DWC header' );
  374.                Ierr := End_Of_File;
  375.             END;   
  376.  
  377.                                    (* Dispose of RAM-resident directory *)
  378.  
  379.          IF ( Dir_Ptr <> NIL ) THEN
  380.             FREEMEM( Dir_Ptr , Dir_Size );
  381.  
  382.                                    (* Close DWC file *)
  383.  
  384.          End_Contents_Listing( DWCFile , Ierr );
  385.  
  386.       END;
  387.  
  388. END   (* Display_DWC_Contents *);
  389.